home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_rain < prev    next >
Encoding:
Text File  |  1991-12-30  |  1.9 KB  |  75 lines
  1. \ Demonstrate simple graphics operations using JForth.
  2. \ This demo is a similar to the BOXES demo.
  3. \
  4. \ Focusses activty in rectanglular blocks.
  5. \
  6. \ Author: Phil Burk
  7. \ Copyright 1986  Delta Research
  8.  
  9. include? newwindow.setup ju:amiga_graph
  10. include? ?closebox ju:amiga_events
  11. include? choose ju:random
  12.  
  13. ANEW TASK-DEMO_RAIN
  14.  
  15. VARIABLE XCENT
  16. VARIABLE YCENT
  17.  
  18. : RAINDROP ( w   -- , draw random star in rect, in current color)
  19.     dup choose -2 ashift 1+ swap  ( -- rh w )
  20.     -2 ashift over - 1+ swap  ( -- sw-rh rh )
  21. \    choose -2 ashift 1+ swap  ( -- rw rh , scaled random width and height )
  22.     xcent @ 2 pick -
  23.     ycent @ 2 pick -   ( -- rw rh topx lefty)
  24.     xcent @ 4 pick +
  25.     ycent @ 4 pick +   ( -- rw rh topx lefty botx righty , corners )
  26.     gr.rect  ( Draw filled rectangle. )
  27.     2drop
  28. ;
  29.  
  30. VARIABLE IF-CYCLE
  31. VARIABLE #R/DIAM
  32. 7 #R/DIAM !
  33.  
  34. : RANDOM.RAIN ( -- , draw raindrops in multiple colors )
  35.     BEGIN
  36.         gr-curwindow @  ..@ wd_width choose    xcent !
  37.         gr-curwindow @  ..@ wd_height choose   ycent !
  38.         #R/DIAM @ 0 DO
  39.             if-cycle @
  40.             IF gr.color@ 1+ 3 and gr.color!  ( Cycle colors. )
  41.             THEN
  42. \ Stay within bounds of current window.
  43. \ Access window structure. ( In 'C':   gr_currentw->width )
  44.             gr-curwindow @  ..@ wd_height
  45.             raindrop
  46.         LOOP
  47. \ Alternate between solid and mixed color diamonds.
  48.         if-cycle @ not if-cycle !
  49. \
  50. \ Occasionally draw in XOR Mode
  51.         5 choose 2 =
  52.         IF    gr_xor_mode gr.mode! ( Toggle drawing mode. )
  53.         ELSE  gr_insert_mode gr.mode! ( Back to normal drawing mode. )
  54.         THEN
  55.         ?closebox
  56.     UNTIL
  57.     gr_insert_mode gr.mode! ( Back to normal drawing mode. )
  58. ;
  59.  
  60. NewWindow BoxWindow   ( Create a template for the new window. )
  61.  
  62. : RAIN  ( -- , Demonstrate raindrops )
  63.     gr.init
  64.     cr ." RAIN - Hit CLOSE BOX to stop!" cr
  65.     BoxWindow NewWindow.Setup   ( Set defaults for window )
  66. \ Create window from template and make it the current window.
  67.     BoxWindow gr.opencurw
  68.     IF random.rain
  69.         gr.closecurw
  70.     THEN
  71.     gr.term
  72. ;
  73.  
  74. cr ." Enter:   RAIN     for demo!" cr
  75.